;;====================================================================
;; manager.lisp
;; 
;;                               written by R.Ueda(garaemon@gmail.net)
;;====================================================================
(declaim (optimize (debug 3) (safety 3)))

(in-package #:roll/gui)

(defvar *manager* nil)

(defun init-gui ()
  "Initialize function for ROLL/GUI package.
   This function must be called before any gui process.

   When it called, <manager>'s instance, *manager* is created
   and open X11 display."
  (unless *manager*
    (setf *manager* (make-instance '<manager>))
    (setf (display-of *manager*) (xlib:open-display ""))
    (setf (root-screen-of *manager*) (car (xlib:display-roots (display-of *manager*))))
    (setf (root-window-of *manager*) (xlib:screen-root (root-screen-of *manager*)))
    (setf (logger-of *manager*) (roll/util:make-logger :file-name "/tmp/roll-gui.log"
                                                       :verbose nil
                                                       :syslog nil))
     (setf (event-thread-of *manager*)
           (roll/util:make-thread (lambda () (while t (event-loop *manager*)))))
    )
  *manager*)

(defgeneric xlib-window->window (manager win))
(defmethod xlib-window->window ((manager <manager>) win)
  "convert window of xwindow to <window> instance."
  (find win (windows-of manager) :key #'xwindow-of))

(defmacro with-xlib-window (params &rest bodies)
  "exec bodies if the window exists.

  params a list like (symbol xwindow manager)"
  (let ((xwin (gensym))
        (manager (gensym)))
    `(let* ((,manager ,(caddr params))
            (,xwin (xlib-window->window ,manager ,(cadr params))))
       (let ((,(car params) ,xwin))
           (if ,xwin
               (progn ,@bodies)
               nil)))))

(defgeneric flush (manager))
(defmethod flush ((man <manager>))
  "Flush XWindow output."
  (xlib:display-force-output (display-of man)))

(defmethod log-format ((manager <manager>) level (str string) &rest args)
  (apply #'log-format (logger-of manager) level str args))

(defgeneric event-loop (manager))
(defmethod event-loop ((manager <manager>))
  (xlib:event-case ((display-of manager)
                    :force-output-p nil
                    :discard-p t)
                   (:exposure
                    (window x y width height count)
                    (with-xlib-window (win window manager)
                      (roll/util:with-mutex ((mutex-of manager))
                        (log-format manager :info ":exposure event to ~A" win)
                        (exposure-callback win x y width height count)))
                    t)
                   (:resize-request
                    (window width height)
                    (with-xlib-window (win window manager)
                      (roll/util:with-mutex ((mutex-of manager))
                        (log-format manager :info ":resize-request event to ~A" win)
                        (resize-callback win width height)))
                    t)
                   (:enter-notify
                    ()
                    (log-format manager :info ":enter-notify event")
                    t)
                   (:button-press
                    (window x y)
                    (with-xlib-window (win window manager)
                      (roll/util:with-mutex ((mutex-of manager))
                        (log-format manager :info ":enter-notify event to ~A" win)
                        (button-press-callback win x y)))
                    t)
                   (:button-release
                    (window x y)
                    (with-xlib-window (win window manager)
                      (roll/util:with-mutex ((mutex-of manager))
                        (log-format manager :info ":button-relase event to ~A" win)
                        (button-release-callback win x y)))
                    t)
                   (otherwise
                    ()
                    t)
                   )
  (iterate:iter (iterate:for win in (remove-if
                                     #'(lambda (w) (subtypep (class-of w) '<widget>))
                                     (windows-of manager)))
                (render-widgets win)
                (flush-window win :clear t))
  (iterate:iter (iterate:for win in (remove-if-not
                                     #'(lambda (w) (subtypep (class-of w) '<widget>))
                                     (windows-of manager)))
                (flush-window win :clear t))
  (flush manager)
  )
  
(defmethod add-window ((manager <manager>) (window <window>))
  (roll/util:with-mutex ((mutex-of manager))
    (push window (windows-of manager))
    (setf (manager-of window) manager))
  window)

(defun xflush nil
  (xlib:display-finish-output (display-of *manager*)))

(defun default-event-mask ()
  (xlib:make-event-mask :exposure
                        :button-press
                        :button-release
                        :resize-redirect))